; PLUGIN STEP 3: DEFPROTO
  (defproto vista-loglinear-proto 
  '(models-adjusted-list 
    vars curr-model 
    ncat 
    counts 
    terms 
    level-labels
    data-matrix 
    data-object 
    sorted-labels
    model 
    be-hierarchic? 
    use-logs?
    excluded-categories
    indicators-list
    order-of-variables
    dependent-variable) 
  () analysis-plugin-object-proto)


;; PLUGIN STEP 4: ISNEW


(defmeth vista-loglinear-proto :variable (&optional args)
  (send self :counts))

(defmeth vista-loglinear-proto :active-data-matrix (&optional args)
 (send *current-data* :active-data-matrix args))

(defmeth vista-loglinear-proto 
  :isnew (&rest args)
  (send self :model-abbrev "LgLin")
  (send self :dialog (select args 4))
  (send self :vars (select args 6))
  (send self :ncat (select args 7))
  (send self :counts (select args 8))
  (send self :level-labels (select args 10))
  (send self :excluded-categories (combine (mapcar 'car (send self :level-labels))))
  (send self :data-matrix (select args 11))
  (send self :models-adjusted-list (select args 5))
  (send self :curr-model (car (select args 5)))
  (send self :terms (list (iseq (length (select args 9)))))
  (send self :sorted-labels (select args 12))
  ;(send self :model (list (select (send self :list-terms) (iseq (length (send self :terms))))))
  (send self :model (list (send self :list-terms)))
  (call-next-method "Log linear analysis" "Loglin" "Lgl" '("freqclass" "freq" "class") 
             (select args 1) 
                    (strcat "LogLin" "-" (send (select args 1) :name))
                    (send (select args 1) :name)
                    (select args 4) '(numeric category))
  
  )

; PLUGIN STEP 5: SLOT ACCESSORS

(defmeth vista-loglinear-proto :models-adjusted-list 
  (&optional (objects-list nil set))
"List of models previously fitted"
  (if set (setf (slot-value 'models-adjusted-list) objects-list))
  (slot-value 'models-adjusted-list))


(defmeth vista-loglinear-proto :vars 
  (&optional (variables-list nil set))
"List of variables in the data"
  (if set (setf (slot-value 'vars) variables-list))
  (slot-value 'vars))

(defmeth vista-loglinear-proto :curr-model 
  (&optional (object nil set))
"Current model fitted"
  (if set (setf (slot-value 'curr-model) object))
  (slot-value 'curr-model))

(defmeth vista-loglinear-proto :ncat 
  (&optional (listcats nil set))
"List of numbers of categories"
  (if set (setf (slot-value 'ncat) listcats))
  (slot-value 'ncat))

(defmeth vista-loglinear-proto :counts
  (&optional (listcounts nil set))
"List of counts of data"
  (if set (setf (slot-value 'counts) listcounts))
  (slot-value 'counts))

(defmeth vista-loglinear-proto :terms
  (&optional (listterms nil set))
"Positions of terms in model"
  (if set (setf (slot-value 'terms) listterms))
  (slot-value 'terms))

(defmeth vista-loglinear-proto :model
  (&optional (model nil set))
"Positions of terms in model"
  (if set (setf (slot-value 'model) model))
  (slot-value 'model))

(defmeth vista-loglinear-proto :level-labels
  (&optional (labels nil set))
"Positions of terms in model"
  (if set (setf (slot-value 'level-labels) labels))
  (slot-value 'level-labels))

(defmeth vista-loglinear-proto :data-matrix
  (&optional (data-matrix nil set))
"Data analyzed after being sorted"
  (if set (setf (slot-value 'data-matrix) data-matrix))
  (slot-value 'data-matrix))

(defmeth vista-loglinear-proto :data
  (&optional (object nil set))
"Data object analyzed"
  (if set (setf (slot-value 'data) object))
  (slot-value 'data))

(defmeth vista-loglinear-proto :sorted-labels
  (&optional (labels nil set))
"Data object analyzed"
  (if set (setf (slot-value 'sorted-labels) labels))
  (slot-value 'sorted-labels))

(defmeth vista-loglinear-proto :be-hierarchic?
  (&optional (be-hierarchic? nil set))
"This selects if the model works hierarchically"
  (if set (setf (slot-value 'be-hierarchic?) be-hierarchic?))
  (slot-value 'be-hierarchic?))

(defmeth vista-loglinear-proto :use-logs?
  (&optional (use-logs? nil set))
"Selects if the mosaic plots show logs or raw data"
  (if set (setf (slot-value 'use-logs?) use-logs?))
  (slot-value 'use-logs?))


(defmeth vista-loglinear-proto :excluded-categories
  (&optional (excluded-categories nil set))
"A list with the reference categories used"
  (if set (setf (slot-value 'excluded-categories) excluded-categories))
    (when excluded-categories (send self :level-labels
                                  (mapcar #'(lambda (cat label) 
                                      (combine cat (sort-data (remove cat label :test #'equal))))
                                      excluded-categories (send self :level-labels))))
  (slot-value 'excluded-categories)
  )
  

(defmeth vista-loglinear-proto :indicators-list
  (&optional (indicator nil set))
"Keeps a list of lists of names of indicators and values of the indicators -ones or zeros-"
  (if set (setf (slot-value 'indicators-list) indicator))
  (slot-value 'indicators-list))

   (defmeth vista-loglinear-proto :order-of-variables
     (&optional (list nil set))
     "Order for showing the variables in the plot of parameters"
     (if set (setf (slot-value 'order-of-variables) list))
     (slot-value 'order-of-variables))

(defmeth vista-loglinear-proto :dependent-variable
     (&optional (string nil set))
     "Dependent variable for logit models"
     (if set (setf (slot-value 'dependent-variable) string))
     (slot-value 'dependent-variable))

; PLUGIN STEP 6: OPTIONS METHOD
    ;Even though the options method is empty it has to be here.
  (defmeth vista-loglinear-proto :options ()
    )

; PLUGIN STEP 7: ANALYSIS METHOD
    ; This plugin is unusual because the analysis method is empty 
    ;and the analysis is carried out in the visualize method. 

(defmeth vista-loglinear-proto :analysis ()
    )

; PLUGIN STEP 8: REPORT METHOD

(defmeth vista-loglinear-proto :report (&key (dialog nil))
  (setf model (select (send self :model) 
                      (position (send self :curr-model) 
                                (send self :models-adjusted-list))))
  (when (= (length model) (length (send self :list-terms))) 
        (setf model (list "Saturated-All terms and interactions are included")))
  (setf pnames (send (send self :curr-model) :predictor-names))
  (setf w (report-header "Report Loglinear" :page t))
  (display-string 
   (format nil "Dummy Coding. ~%") w)
  (display-string 
   (format nil "Categories of Reference (Excluded) are: ~%") w)
  (display-string (format nil "~25a~25a~%" "Variable" "Category Excluded") w)
  (mapcar #'(lambda (lab var)
             (display-string (format nil "~25a ~25a ~%" var lab) w))
          (send self :excluded-categories)
          (send self :vars))
                       
  (defmeth (send self :curr-model) :display ()
    "Message args: ()
Prints the IRWLS regression summary. Has been taken from Tierney's original and modified to print in a report window."
    (let (
          (coefs (coerce (send self :coef-estimates) 'list))
          (se-s (send self :coef-standard-errors))
          (x (send self :x))
          (p-names pnames)
          )
      (display-string (format nil "~%MODEL~%") w)
      (mapcar #'(lambda (term) 
                  (display-string (format nil (princ-to-string term) ) w)
                  (display-string (format nil "~%") w))
              model)
      
      #|(if (send self :estimate-scale)
          (display-string (format nil "Scale Estimate:~25t~13,6g~%" (send self :scale)) w)
          (display-string (format nil "Scale taken as:~25t~13,6g~%" (send self :scale)) w))|#
      (display-string (format nil "~%GOODNESS OF FIT~%") w)
      (display-string (format nil "Deviance:~25t~13,6g~%" (send self :deviance)) w)
      (display-string (format nil "Number of cases:~25t~9d~%" (send self :num-cases)) w)
      (if (/= (send self :num-cases) (send self :num-included))
          (display-string (format nil "Number of cases used:~25t~9d~%" (send self :num-included)) w))
      (display-string (format nil "Degrees of freedom:~25t~9d~%" (send self :df)) w)
      (display-string (format nil "p:                     ~25t~6f~%" (- 1 (if (= (send self :df) 0) 
                                                         0 
                                                         (chisq-cdf 
                                                          (send self :deviance) 
                                                          (send self :df))))) w)
      (if (send self :weights) 
          (display-string 
           (format nil "~%~%Weighted Least Squares Estimates of Parameters in the Model:~%") w)
          (display-string (format nil "~%Least Squares Estimates:~2%") w))
     
     #| (display-string (format nil "Parameter~20a~20a~20a~20a~%" 
                              "" "Estimate" "s.e." "z") w)
      (when (send self :intercept)
            (display-string
             (format nil "Constant~25t~20,3g~40t~,3g~%" (car coefs) (car se-s)) w)
            (setf coefs (cdr coefs))
            (setf se-s (cdr se-s)))|#
      (setf p-names (combine (list "Constant") p-names))
      (setf mat (bind-columns coefs se-s 
                              (/ coefs se-s) 
                              ;(normal-cdf (/ coefs se-s))
                              (exp coefs)))
      (pv-print-matrix-to-window 
       mat w :decimals 5
       :row-labels p-names
       :column-labels '("Coefficients" "s.e" "z" "Exp(Coef)")
       :row-heading "Terms"
       :column-heading ""
                 )
      #|(dotimes (i (array-dimension x 1)) 
               (cond 
                 ((member i (send self :basis))
                  (display-string (format nil "~a~25t~20,3g~40t~,3g~40t~,6g~%"
                                          (select p-names i) (car coefs) (car se-s) 
                                          (/ (car coefs) (car se-s))) w)
                  (setf coefs (cdr coefs) se-s (cdr se-s)))
                 (t (display-string (format nil "~a~25taliased~%" (select p-names i)) w))))
  |#

      (display-string (format nil "~%") w)
      (when (send self :fitted-zeros)
            (send self :print-zero-data-problems w))
      (send w :top-most t)
      (send w :fit-window-to-text)))
  (send (send self :curr-model) :display)
  )


; PLUGIN STEP 9: CREATE DATA

(defmeth vista-loglinear-proto :create-data 
  (&key (dialog nil)
        (observed nil)
        (all t))
"Args: DIALOG (observed t) (all t)
Creates 1 or 2 output data objects. If DIALOG=T then presents dialog to determine which objects created. Otherwise presents specified objects. If no options, specified, creates both data objects."
  (if (not (eq current-object self)) (setcm self)) 
  (let* ((creator (send *desktop* :selected-icon))
         (curr-model (send self :curr-model))
         (design-matrix (send curr-model :x))
         (dep-var (send curr-model :yvar))
         (predicted (send curr-model :fit-means))
         (chi-residuals (send curr-model :chi-residuals))
         (adj-chi-residuals (send curr-model :adj-chi-residuals))
         (leverages (send curr-model :leverages))
         (cooks-distances (send curr-model :cooks-distances))
         (matrix (bind-columns design-matrix 
                               dep-var 
                               predicted 
                               chi-residuals
                               adj-chi-residuals
                               leverages
                               cooks-distances))
         (vars (combine 
                (send self :predictor-names) 
                "Count"
                "Predicted"
                "Chi-residuals"
                "Adj-chi-residuals"
                "Leverages"
                "Cooks-distances"))
         (labels (send curr-model :case-labels))
         (numnum (length vars))
        )

    (data (send self :name)
          :created creator
          :creator-object self
          ;:freq (= type 0)
          :title (send self :title)
          :data (combine matrix)
          :variables vars
          :labels labels
          :types (repeat "Numeric" numnum)
    )))


(defmeth vista-loglinear-proto :list-terms ()
  (let* ((terms (expand-hierarchy 
                (list (iseq (length (send self :vars))))))
     (temp-terms-cat (mapcar #'(lambda (ter) (select (send self :vars) ter))
                        terms))
     (terms-cat (mapcar #'(lambda (x) (apply 'strcat (car x)
                                             (mapcar #'(lambda (y) 
                                                         (strcat "|" y )) 
                                                     (cdr x))))
                        temp-terms-cat)))
    terms-cat))
         

(provide "logliplg")
